00100	C 3/19/83  ******** SUBROUTINE JUSTFY, ROOM, JSPACE *****
00200		SUBROUTINE JUSTFY(JLP,ITEM,NPW,NO,RN,RSTFAC,R2,R4,R5)
00300	CX	SUBROUTINE JUSTFY(JLP,R,IR,NO,NP,RN,RSTFAC,R2,R4,R5,R6,R8,R9)
00400	COPYRIGHT 1983 BY LELAND SMITH
00500	CC	COMMON/RINP/XPS(250),NP(250),NQ(400),XPR(250)
00600		COMMON /JST/ N,XP(400),XPL(400),XPS(400),NP(400),XPR(400)
00700		DIMENSION RN(1),NO(1),RSTFAC(0/1),NPW(1)
00800	C DATA FOR SPACE FOR SOME ITEMS
00900	C	DATA RNT/3.0/,RST/3.0/,CLF/6.5/,BAR/1.0/,SIGL/2.5/,SIGR/1.0/
01000	C	1,ACCI/3.0/,RLDG/2.0/,TSR/4.0/,TSL/2.0/,TTSR/6.0/,TTSL/3.0/
01100		DATA RNT/3.6/,RST/3.0/,CLF/6.5/,BAR/1.0/,SIGL/2.5/,SIGR/1.0/
01200		1,ACCI/2.5/,RLDG/1.6/,TSR/4.0/,TSL/2.0/,TTSR/6.0/,TTSL/3.0/
01300		1,HALF/3.9/,WHOL/4.3/,DBW/4.8/,DOT/2.2/,SIG/2.0/,SIGN/2.0/
01400		1,BARR/1.3/
01500	C RNT=NOTE, RST=REST, TSR=METER RIGHT, TTSR=DBL DIGIT METER, ETC.
01600	C RLDG=LEDGER LINE, SIGR=KEY SIG. RT, SIG=SIZE OF ACCI IN KSIG
01700	C SIGN=SPACE FROM KSIG TO NOTE, BARR=EXTRA FOR NOTE TO RT OF BAR
01800	
01900	C JLP= TOP STAFF NUM.
02000	C R2=THIS STAFF NUM.  R4=LEFT EDGE, R5=RIGHT EDGE.
02100	
02200		RJLP=JLP
02300		NN=0
02400	C BEGIN SETUP OF NEEDED POINTERS
02500		DO 50 K=1,ITEM
02600		L=NPW(K)
02700	C POINTER TO RN ARRAY
02800		IF(R2.GT.RJLP)GO TO 55
02900	C JUMP IF LOOKING AT ALL STAVES
03000		IF(R2.NE.RN(L+2))GO TO 50
03100	C SKIP IF NOT RIGHT STAFF
03200	55	M=RN(L+1)
03300	C CODE NUM.
03400		IF(M.GT.4.AND.M.LT.17)GO TO 50
03500	C LOOK AT NOTES, RESTS, CLEFS, BARS, KSIG, METER.
03600		RL=RN(L)
03700	C  WORD COUNT
03800		RR3=RN(L+3)
03900	C HORIZ. POSITION
04000		IF(RR3+0.1.LT.R4.OR.RR3.GT.R5)GO TO 50
04100	C JUMP IF NOT IN BOUNDS
04200		GO TO(51,52,53,54)M
04300	C NOW CODE 17 OR 18
04400		GO TO 59
04500	51	IF(RN(L+9).LT.0)GO TO 50
04600	C NEED WDCNT CHECK HERE?   JUMP IF NON-IMPORTANT NOTE
04700	59	NN=NN+1
04800		NP(NN)=L
04900		IF(NN.LE.250)GO TO 50
05000	C TOO MUCH DATA?
05100		WRITE(5,69)NN
05200		GO TO 57
05300	69	FORMAT(' ***** TOO MUCH.  JUSTIFY LIMIT = ',I3)
05400	52	RR6=RN(L+6)
05500		RR7=RN(L+7)
05600		RR8=RN(L+8)
05700		IF(RL.GE.4.0.AND.RR6.LT.0)GO TO 50
05800		IF(RL.GE.5.0.AND.RR7.LT.0)GO TO 50
05900	C SKIP INVISIBILE RESTS AND RESTS WITH NEG. RHY.
06000		IF(RL.GE.6.0.AND.RR8.NE.0)GO TO 50
06100	C RR8<0=CENTERED WHOLE REST - ASSUMES NO NEED TO JUSTIFY.
06200		GO TO 59
06300	53	IF(RL.LT.3.0)GO TO 59
06400		IF(RN(L+5).LE.4.0)GO TO 59
06500	C FOUND TRUE CLEF (0=TREB, 1=BASS, 2=ALT, 3=TEN, 4=PERC.)
06600		GO TO 50
06700	54	IF(RL.GT.3.OR.RN(L+4).LT.0)GO TO 50
06800	C IF P4.LT.0 THEN IT'S AN INVISIBLE BAR.
06900		GO TO 59
07000	CC  FOR REPEAT BAR WDCNT IS 3 -- 10/77 444	IF(RL.GT.2)GO TO 2
07100	C  SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
07200	50	CONTINUE
07300	
07400	C FIRST SORT BY STAFF NUM. AND HORIZ. POS.
07500	57	N=2
07600	61	M=NP(N)+2
07700		KK=N-1
07800		JJ=NP(KK)+2
07900		Z=RN(M)*1000.0+RN(M+1)
08000		X=RN(JJ)*1000.0+RN(JJ+1)
08100		IF(Z.GE.X)GO TO 62
08200	COMPARE STAFF NUMS.*1000 + HORIZ. POS.
08300		M=NP(N)
08400		NP(N)=NP(KK)
08500		NP(KK)=M
08600	C EXCHANGE POINTERS AND TRY AGAIN
08700		IF(N.GT.2)N=KK
08800		GO TO 61
08900	62	N=N+1
09000		IF(N.LE.NN)GO TO 61
09100	C NOW ALL SORTED BY STAFF NUM. AND POS.
09200		XP(1)=R4
09300		XPL(1)=0
09400		XPR(1)=0
09500		XPS(1)=-1.0
09600	C SET LEFT EDGE OF JUSTIFY AREA
09700		N=2
09800		DO 200 K=1,NN
09900		L=NP(K)
10000		RL=RN(L)
10100	C  RL=WDCNT-2
10200		RA=RN(L+1)
10300	C  RA=CODE NUM.
10400		RR3=RN(L+3)
10500	C  RR3=POSITION(P3)
10600		RR2=RN(L+2)
10700	C  RR2=STAFF NUM. OF THIS ITEM
10800		RY=1.
10900	C BASIC SIZE FACTOR
11000		PL=0
11100		RR5=RN(L+5)
11200	C  RR5=PARAM 5    RR6=P6   RW=P4 
11300		RR6=RN(L+6)
11400	78	RR4=RN(L+4)
11500	C  RR4=HEIGHT-MINI(P4)
11600		M=RA
11700		GO TO(1,2,3,4)M     
11800	C  LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
11900	
12000		IF(M.EQ.18)GO TO 18
12100		GO TO 17
12200	
12300	C***** NOTES ******
12400	1	RR7=RN(L+7)
12500	C RR7=P7  DOTS, TAILS
12600		RC=ABS(RR4)
12700		RR4=AMOD(RR4,100.0)
12800		IF(RR4.GT.80.0)RR4=RR4-100.0
12900		IF(RC.LT.80.)GO TO 19
13000		IF(RC.LT.180.)RY=.6
13100	C  FOUND A MINI-NOTE
13200	
13300	CC19	PL=1.
13400	C SPACE NEEDED TO LEFT
13500	19	PR=RNT
13600	C SPACE NEEDED TO RIGHT (SEE DATA)
13700		PRR=0
13800	C STORES EXTRA SPACE TO RIGHT
13900		PLL=0
14000	C STORES EXTRA SPACE TO LFT
14100		
14200	10	IF(RR7.EQ.0)GO TO 12
14300	C TAIL ON NOTE?  (CHECK FOR HALF, WHOLE NOTES, RR6<0)
14400		RR=AMOD(RR7,10.0)
14500		IF(RR.LE.0.OR.RR6.LT.0)GO TO 11
14600		IF(RR5.LT.10.0.OR.RR5.GE.20.0)GO TO 11
14700	C SKIP IF NO STEM OR STEM DOWN
14800		PRR=1.8
14900	C ADD ROOM FOR TAIL
15000		
15100	11	KK=RR7/10
15200		PX=DOT*KK
15300	C SPACE FOR DOT(S)
15400		PX=PX+AMOD(RR7,1.0)*10.0
15500	C ADD SOME IF DOTS SPACED EXTRA TO RIGHT (E.G. 1.23=2.3 SPACES TO RT.)
15600		IF(PX.GT.PRR)PRR=PX
15700		IF(RR7.GE.10.0)GO TO 1012
15800	C NOTE HAS DOT, NO SPACE NEEDED FOR LEDGER LINE.
15900		IF(RR5.GE.10.0.AND.RR5.LT.20.0.AND.AMOD(RR7,10.0).GE.1.0)
16000		1 GO TO 1012
16100	C SKIP IF NOTE HAS TAIL ON STEM UP.
16200	12	IF(RR4.LT.13.0.AND.RR4.GT.1.0)GO TO 1012
16300	C IF LEDGER LINES ADD SPACE TO RIGHT
16400		 IF(PRR.GE.RLDG)GO TO 1012
16500	C ALREADY ENOUGH SPACE FOR LEDGER LINE EXTENSION - SKIP NEXT
16600		JJ=0
16700	C NOW FIND NEXT CLOSEST NOTE TO RIGHT ON THIS STAFF.
16800		X=RR4-13.0
16900		KK=K+1
17000	1000	IF(KK.GT.NN)GO TO 1012
17100		J=NP(KK)
17200		IF(RN(J+1).NE.1.0)GO TO 1012
17300	C JUMP IF NEXT IS NOT NOTE
17400		IF(RN(J+2).NE.RR2)GO TO 1012
17500	C JUMP IF NOT ON SAME STAFF
17600		IF(RN(J+3)-RR3.GT.0.1)GO TO 1003
17700	C JUMP IF NEXT NOTE NOT SAME POS.
17800		KK=KK+1
17900		GO TO 1000
18000	1003	Y=RN(J+3)
18100	C SAVE POS OF NEXT NOTE
18200	1006	IF(AMOD(RN(J+5),10.0).GE.1.0)GO TO 1012
18300	C JUMP IF NEXT NOTE HAS ACCI.   ENOUGH ROOM ALREADY
18400		Z=AMOD(RN(J+4),100.0)
18500	C HEIGHT OF NOTE
18600		IF(X.GE.0)GO TO 1001
18700	C JUMP IF PREV. NOTE WAS ABOVE STAFF
18800		IF(Z.LE.1.0)GO TO 1002
18900	C JUMP IF THIS NOTE AND LAST BELOW STAFF
19000		GO TO 1004
19100	1001	IF(Z.LT.13.0)GO TO 1004
19200	1002	PRR=RLDG
19300	C ADD SPACE TO RIGHT FOR LEDGER LINE
19400		GO TO 1012
19500	1004	X=RN(J+3)
19600		IF(KK.EQ.NN)GO TO 1012
19700	C JUMP IF NO MORE ITEMS
19800		KK=KK+1
19900		J=NP(KK)
20000		IF(RN(J+2).NE.RR2)GO TO 1012
20100		IF(RN(J+1).NE.1.0)GO TO 1012
20200		IF(RN(J+3)-Y.LE.0.1)GO TO 1006
20300	C GO BACK AND TRY AGAIN IF NEXT NOTE IS PART OF CHORD
20400	
20500	1012	RR=AMOD(RR5,10.0)
20600	C ANY ACCIDENTALS?
20700		IF(RR.EQ.0)GO TO 13
20800		PLL=ACCI
20900		IF(IFIX(RR).EQ.4)PLL=ACCI+2.0
21000	C RR=4 = DOUBLE FLAT
21100	CCC	PLL=3.0
21200	CCC	IF(IFIX(RR).EQ.4)PLL=5.0
21300		PLL=PLL+AMOD(RR5,1.0)*10.0
21400	C INCREASE IF ACCI. SPACED TO LEFT. (E.G. 12.21 =2.1 SPACES TO LEFT)
21500	
21600	13	IF(ABS(RR6).LT.1.0)GO TO 14
21700	C LOOK FOR HALF NOTES, WHOLE NOTES, NOTES ON WRONG SIDE OF STEM.
21800		KK=0
21900		IF(RR6.GT.0)GO TO 130
22000	C NOW IT'S A WHITE NOTE
22100		PR=HALF
22200	C SEE DATA FOR SPACE FOR HALFNOTE
22300		KK=IFIX(AMOD(RR7,10.0))
22400	C GET RT. DIGIT IN P7
22500		IF(KK.EQ.1)PR=WHOL
22600		IF(KK.EQ.2)PR=DBW
22700	C =1=WHOLENOTE, =2=DOUBLE WHOLENOTE
22800		IF(RR6.GT.-10.0)GO TO 14
22900	C NOW NOTE ON WRONG SIDE OF STEM
23000	130	AR=2.5
23100		IF(KK.EQ.1)AR=3.0
23200		IF(KK.EQ.2)AR=3.5
23300		IF(ABS(RR6).GE.20.0)GO TO 135
23400	C NOW NOTE TO RIGHT OF STEM
23500		PRR=PRR+AR
23600		GO TO 14
23700	135	PLL=PLL+AR
23800	C ADD SPACE TO LEFT IF NOTE ON LEFT SIDE OF STEM
23900	
24000	14    	PR=(PR+PRR)*RY
24100		PL=(PL+PLL)*RY
24200		
24300		IF(RL.LT.8)GO TO 700
24400	C JUMP IF THERE IS NOT P10 TO LOOK AT
24500		IF(RN(L+10).EQ.0)GO TO 700
24600		RR2=RR2+1
24700	CC	RW=RN(L+10)
24800	C PUT P10 INTO RW
24900		IF(RN(L+10).LT.2.0)RR2=RR2-2.
25000	C NOW STAFF # IS SET TO WHERE NOTE REALLY IS.
25100		GO TO 700
25200	
25300	C***** RESTS *****
25400	2	PR=RST
25500		IF(RL.GE.5.0)PR=PR+RR6*2.0
25600	C RR6=DOTS
25700	CC	PL=1.0
25800		GO TO 700
25900		
26000	3	IF(RL.GE.2.AND.RR4.GE.100.0)RY=.85
26100		PR=CLF*RY
26200		GO TO 700
26300	
26400	C4	PL=0.5
26500	4	PL=1.0
26600		PR=BAR
26700	C PL=SPACE NEEDED TO LEFT, PR=SPACE NEEDED TO RIGHT, RR3=POS. OF ITEM
26800		KX=RR4/1000.
26900		IF(KX.LE.0.)GO TO 40
27000		PL=3.2
27100	C  ADD A LITTLE SPACE IN FRONT OF DBL BAR.
27200		IF(KX.EQ.2.OR.KX.EQ.4)PR=6.0
27300	C KX=2=DOTS TO RIGHT
27400		IF(KX.GT.2)PL=4.2
27500	C KX>2=DOTS TO LEFT
27600	CC	IF(RL.LT.3)GO TO 700
27700	C JUMP IF THIN DBL BAR. OLD DBL BAR HAS 1 IN R5.
27800	CC229	IF(KX.NE.2)PR=PR+PR
27900	C 2=DOTS TO RT. 1 OR 4=DOTS TO LFT. 3=DOTS ON BOTH SIDES.
28000	C  REPT BAR WITH DOTS TO LEFT.  ADD SPACE IN FRONT OF IT.
28100	CC	PL=-PL/RBX
28200	CC	IF(KX.EQ.4)KX=0
28300	CC129	IF(KX.GE.2)PL=RBZ*PL
28400	C  IF DOTS TO RIGHT ADD MORE SPACE AFTER REPT BAR.
28500		GO TO 42
28600	40	Z=999.
28700	C FIND NEXT CLOSEST ITEM.
28800		DO 41 M=1,NN
28900		J=NP(M)
29000		IF(R2.LE.RJLP.AND.R2.NE.RN(J+2))GO TO 41
29100	C SKIP IF NOT ON RIGHT STAFF
29200		X=RN(J+3)
29300		IF(X.GT.Z.OR.X.LE.RR3)GO TO 41
29400		Z=RR3
29500		L=J
29600	C SAVE POS. AND CODE NUM.
29700	41	CONTINUE
29800		IF(RN(L+1).LE.2.0)PR=PR+BARR
29900	C IF A NOTE OR REST, ADD 1.5 TO SPACE
30000	
30100	42	RR4=AMOD(RR4,100.0)
30200	C FIND HOW MANY STAVES UP THE BAR GOES
30300		IF(RR4.EQ.0)RR4=1.0
30400		RR4=RR4+RR2
30500	43	CALL ROOM(RR3,PL,PR,RR2,R4,R5,RSTFAC)
30600	C    RR3=POS.,PL=NEED TO LEFT,PR=NEED TO RIGHT, RR2=STAFF#
30700		RR2=RR2+1.0
30800	C RESERVE SPACE FOR BAR LINE ON EVERY STAFF COVERED.
30900		IF(RR2.LT.RR4)GO TO 43
31000		GO TO 200
31100	
31200	C KSIG  
31300	17	RR5=ABS(RR5)
31400		IF(RR5.GE.100)RR5=RR5-100
31500	C  +100 FOR NATURALS AS KEYSIG.
31600		PR=SIGR+SIG*(RR5-1)
31700	C  SPACES FOR CORRECT NUM OF ACCIS.  RR5=NUM OF ACCIS.
31800		PL=SIGL
31900		IF(K+1.GT.NN)GO TO 700
32000	C WHAT FOLLOWS KSIG?
32100		KK=NP(K+1)
32200		IF(RN(KK+2).NE.RR2)GO TO 700
32300		IF(RN(KK+1).LE.2.0)PR=PR+SIGN
32400	C FIND NOTE OR REST  ADD VALUE OF SIG_N TO PR 
32500		GO TO 700
32600	
32700	C METER
32800	18	RC=0
32900		IF(RL.GE.7)RC=9
33000	C FOR COMPOSITE METERS. NO CHECK FOR DBL DIGITS YET.
33100		PR=TSR
33200		PL=TSL
33300		IF(RR6.LE.9.AND.RR5.LE.9)GO TO 180
33400	C  CHECKS FOR 2-DIGIT METERS
33500		PR=TTSR
33600		PL=TTSL
33700	180	PR=PR+RC
33800	700	CALL ROOM(RR3,PL,PR,RR2,R4,R5,RSTFAC)
33900	C    RR3=POS.,PL=NEED TO LEFT,PR=NEED TO RIGHT, RR2=STAFF#
34000	200	CONTINUE
34100		CALL JSPACE(NO,R2,R4,R5,RN)
34200	300	END
34300	
34400		SUBROUTINE ROOM(RB,RL,RR,STAF,R4,R5,RSTFAC)
34500	C SETS UP ARRAYS CONTAINING ALL NEEDED SPACE INFO
34600		COMMON /JST/ N,P(400),PL(400),PS(400),NP(400),PR(400)
34700	CC	COMMON/RINP/PS(250),NP(250),NQ(400),PR(250)
34800	CC	COMMON /JST/ N,P(250),PL(250)
34900	C SHARE THESE ARRAYS WITH SOME OTHERS??? (RINP?)
35000		DIMENSION RSTFAC(0/1)
35100		P(N)=0
35200		PL(N)=0
35300		PR(N)=0
35400		PS(N)=-1
35500	C ZERO OUT NEXT ARRAY SLOTS
35600		IF(ABS(RB-R4).LE.0.1)RL=0
35700		IF(ABS(RB-R5).LE.0.1)RR=0
35800	CHECK TO SEE IF ITEM IS AT LEFT OR RIGHT EDGE OF JUSTIFY AREA.
35900		K=STAF
36000		S=RSTFAC(K)
36100	C GET PROPER SIZE FACTOR FOR THIS STAFF
36200		RL=RL*S
36300		RR=RR*S
36400		DO 1 K=1,N-1
36500		IF(ABS(RB-P(K)).GT.0.1)GO TO 1
36600	C SAME POSITION?
36700		IF(RB.LT.P(K))P(K)=RB
36800	C USE POSITION FARTHEST TO LEFT
36900		IF(STAF.NE.PS(K))GO TO 1
37000	C SAME STAFF?
37100		IF(PR(K).LT.RR)PR(K)=RR
37200		IF(PL(K).LT.RL)PL(K)=RL
37300	C ITEM IN SAME POS.  CHANGE SPACE REQUIREMENTS IF NECESSARY.
37400		RETURN
37500	1	CONTINUE
37600		P(N)=RB
37700		PR(N)=RR
37800		PL(N)=RL
37900		PS(N)=STAF
38000		N=N+1
38100	C PUT AWAY MORE SPACE NEEDS.
38200		END
38300	
38400		SUBROUTINE JSPACE(NO,R2,R4,R5,RN)
38500		DIMENSION NO(1),RN(1)
38600		COMMON /JST/ N,P(400),PL(400),PS(400),NP(400),PR(400)
38700	CC	COMMON/RINP/PS(250),NP(250),NQ(400),PR(250)
38800	CC	COMMON /JST/ N,P(250),PL(250)
38900	CC	P(N)=R5
39000	CC	PR(N)=0
39100	CC	PL(N)=0
39200		P(N)=9999.
39300	C LAST POINT IS RIGHT LIMIT OF JUSTIFY AREA
39400	CC	P(N+1)=9999.
39500	   	N=N-1
39600		K=1
39700	2	A=P(K)
39800		M=K+1
39900		KK=K
40000		DO 1 L=M,N
40100		B=ABS(P(L)-A)
40200		IF(B.GT.0.1)GO TO 6
40300		P(L)=A
40400	C SAME POS.
40500		GO TO 1
40600	6	IF(P(L).GT.A)GO TO 1
40700	C FIND ITEM FURTHEST TO LEFT
40800		A=P(L)
40900		K=L
41000	1	CONTINUE
41100	10	IF(K.EQ.KK)GO TO 3
41200		B=PR(K)
41300		C=PL(K)
41400		D=PS(K)
41500		DO 4 L=K,KK+1,-1
41600	C SHUFFLE ARRAYS
41700		LL=L-1
41800		P(L)=P(LL)
41900		PL(L)=PL(LL)
42000		PR(L)=PR(LL)
42100	4	PS(L)=PS(LL)
42200	11	P(KK)=A
42300		PR(KK)=B
42400		PL(KK)=C
42500		PS(KK)=D
42600	3	K=KK+1
42700		IF(K.LE.N)GO TO 2
42800	
42900	C NOW COLLECT ALL SPACE IN PL ARRAY
43000		DO 20 K=2,N+1
43100		L=K-1
43200		IF(PS(K).NE.PS(L))GO TO 21
43300	C SAME STAFF?
43400		GO TO 23
43500	21	L=K-2
43600	22	IF(PS(L).EQ.PS(K))GO TO 23
43700		L=L-1
43800		IF(L.GT.0)GO TO 22
43900		GO TO 20
44000	23	PL(K)=PL(K)+PR(L)
44100	C FOUND PREVIOUS ITEM ON SAME STAFF.
44200	20	CONTINUE
44300	
44400	C NOW STORE POS  OF EACH PREV. ITEM ON SAME STAFF IN PR ARRAY.
44500		DO 40 K=2,N+1
44600		L=K-1
44700		IF(PS(K).NE.PS(L))GO TO 41
44800	C SAME STAFF?
44900		GO TO 43
45000	41	L=K-2
45100	42	IF(L.LE.0)GO TO 44
45200		IF(PS(L).EQ.PS(K))GO TO 43
45300		L=L-1
45400		IF(L.GT.0)GO TO 42
45500	44	PR(K)=R4
45600	C FAR LEFT POS. OF JUST. RANGE GOES INTO PR
45700	7	GO TO 40
45800	43	PR(K)=P(L)
45900	C FOUND PREVIOUS ITEM ON SAME STAFF.
46000	C STORE POS. OF PREVIOUS ITEM IN PR ARRAY.
46100	40	CONTINUE
46200		PR(1)=R4
46300	
46400	C NOW GET RID OF UNNEEDED DATA
46500		L=2
46600	30	LL=L-1
46700		IF(P(L).NE.P(LL))GO TO 36
46800	C NOW 2 ITEMS IN SAME POS. ON DIFF. STAVES
46900		IF(PR(L).EQ.PR(LL))GO TO 34
47000	C JUMP IF POS. OF PREV. ITEM IS SAME IN BOTH CASES.
47100		A=P(L)-PR(L)-PL(L)
47200		B=P(LL)-PR(LL)-PL(LL)
47300	C A,B = EXCESS SPACE AVAILABLE., KEEP THE ONE WITH THE LEAST.
47400		IF(B.GT.A)L=L-1
47500		GO TO 35
47600	34	IF(PL(L).GT.PL(LL))PL(LL)=PL(L)
47700	C EXCHANGE IF NEEDED SPACE HERE IS < PREVIOUS NEEDED
47800	35	N=N-1
47900	C DECREMENT COUNTER
48000	33	DO 32 K=L,N
48100	C CONTRACT ARRAY
48200		M=K+1
48300		PL(K)=PL(M)
48400		PR(K)=PR(M)
48500	32	P(K)=P(M)
48600		GO TO 9
48700	36	L=L+1
48800	9	IF(L.LE.N)GO TO 30
48900	 
49000	100	DO 101 K=1,N
49100	101	PS(K)=P(K)
49200	C PS WILL HOLD SHIFTED POINTS
49300	99	FORMAT('+',I2,1X,$)
49400	98	FORMAT(' ',$)
49500		TYPE 98
49600		DO 50 J=1,40
49700	C "ACCORDIAN" LOOP - USUALLY EXITS WELL BEFORE 40
49800		Y=0
49900		TYPE 99,J
50000		DO 51 K=2,N
50100		A=PS(K)-PR(K)-PL(K)
50200	C NEG. MOVE REQUIREMENT
50300		IF(A.GE.-0.1)GO TO 51
50400	C SKIP IF ENOUGH SPACE
50500		Y=PS(K)
50600	C SHIFT ALL POINTS FOUND FROM HERE TO FAR RIGHT
50700		DO 52 L=K,N
50800		PS(L)=PS(L)-A
50900	52	IF(PR(L).GE.Y)PR(L)=PR(L)-A
51000		IF(PR(K).EQ.PS(K-1))GO TO 51
51100	C JUMP IF PREVIOUS ITEM ON SAME STAFF
51200	C NOW SHIFT OTHER STAVES' ITEMS FOUND TO LEFT
51300		Z=PR(K)
51400		F=Y-PR(K)
51500	C LOOK IN AREA BOUNDED BY Z AND Y
51600		F=(Y-Z-A)/(Y-Z)
51700	C SPACING FACTOR
51800		DO 53 L=1,N
51900		B=PS(L)
52000		IF(B.LT.Z.OR.B.GT.Y)GO TO 54
52100	C FOUND A POINT TO SHIFT
52200		B=B-Z
52300	C ACTUAL SPACE FROM LEFT LIMIT
52400		PS(L)=Z+B*F
52500	C LEFT LIMIT+SPACE*FACTOR
52600	54	B=PR(L)
52700		IF(B.LT.Z.OR.B.GT.Y)GO TO 53
52800		B=B-Z
52900		PR(L)=Z+B*F
53000	53	CONTINUE
53100	51	CONTINUE
53200		IF(PS(N).LE.R5)GO TO 203
53300	C MORE THAN ENOUGH SPACE EXISTS
53400	        IF(Y.EQ.0)GO TO 203
53500	C JUMP OUT IF NO POINTS MOVED
53600	      F=(R5-R4)/(PS(N)-R4)
53700	C FACTOR TO SHIFT ALL BACK WITHIN ORIGINAL LIMITS
53800		Z=R4-R4*F
53900	        DO 56 K=1,N
54000		PS(K)=Z+PS(K)*F
54100	56	PR(K)=Z+PR(K)*F
54200	CC        PS(K)=R4+(PS(K)-R4)*F
54300	CC56      PR(K)=R4+(PR(K)-R4)*F
54400	50    CONTINUE
54500	
54600	CQ NEXT WAS ATTEMPT TO REPLACE "ACCORDIAN" SYSTEM 3/83  (LABELS 101+1→50)
54700	CQ	GO TO 203
54800	CQ        DIMENSION PSX(300),PRR(300),PG(300)
54900	C GET NUM OF STAFF TO JUSTIFY
55000	CQ        DO 60 K=1,N
55100	C SAVE ALL DATA
55200	CQ        PSX(K)=PS(K)
55300	CQ        PRR(K)=PR(K)
55400	CQ60      PG(K)=PS(K)-PR(K)-PL(K)
55500	C PG ARRAY HAS VALUE OF ALL GAPS.
55600	CQ        J=0
55700	CQ61      T=0
55800	C T=TOTAL GAP SPACE AVAILABLE
55900	CQ        DO 62 K=1,N
56000	CQ        IF(PG(K).LE.0)GO TO 62
56100	C SKIP IF NO GAP IN FRONT OF THIS ITEM
56200	CQ        A=PR(K)
56300	C POS. OF PREVIOUS ITEM ON THAT STAFF
56400	CQ        B=PS(K)
56500	C POS OF THIS ITEM
56600	CQ        G=PG(K)
56700	C ADJUSTED GAP SIZE AVAILABLE
56800	CQ	IF(R2.LT.RJLP)GO TO 66
56900	CQ        GG=0
57000	CQ        DO 63 L=K+1,N
57100	C CHECK FOR K+1 > N
57200	CQ        IF(PS(L).LE.A.OR.PR(L).GE.B)GO TO 63
57300	C JUMP IF ITEM IS TO LEFT OF ITEM K OR PREV. IS TO RIGHT
57400	CQ        IF(PG(L).LE.0)GO TO 63
57500	C JUMP IF NO GAP HERE
57600	CQ        GG=PG(L)
57700	CQ	IF(PS(L)-GG.LT.PS(L-1))GG=PS(L)-PS(L-1)
57800	C GAP CAN BE NO GREATER THAN DIST TO PREV. ITEM ON OTHER STAFF
57900	CQ        IF(GG.LT.G)G=GG
58000	C FIND SMALLEST GAP
58100	CQ63      CONTINUE
58200	CQ        IF(GG.EQ.0)GO TO 62
58300	C JUMP IF NO GAPS WITHIN PROPER BOUNDS ARE FOUND
58400	CQ66      T=T+G
58500	C ADD UP TOTAL GAP SPACE
58600	CQ        DO 64 L=K,N
58700	C NOW SHIFT ALL ITEMS TO LEFT TO FILL IN SMALLEST GAP
58800	CQ        PS(L)=PS(L)-G
58900	CQ        IF(PR(L).GE.B)GO TO 65
59000	C SKIP IF PREV. ITEM IS OUT OF BOUNDS TO RIGHT
59100	CQ        PG(L)=PG(L)-G
59200	C DECREASE THE GAP SIZES
59300	CQ        GO TO 64
59400	CQ65      PR(L)=PR(L)-G
59500	C MOVE BACK POS. OF PREV. ITEM IF IN BOUNDS
59600	CQ64      CONTINUE
59700	CQ62      CONTINUE
59800	CQ        IF(J.NE.0)GO TO 203
59900	C J=-1 SECOND TIME THROUGH LOOP.
60000	CQ        IF(T.EQ.0)GO TO 70
60100	C JUMP IF NO FREE SPACE WAS FOUND
60200	CQ        X=(PSX(N)-R5)/T
60300	C EXTRA SPACE REDUCTION FACTOR
60400	CQ        IF(X.LT.1.0)GO TO 71
60500	C JUMP IF NOT ENOUGH ROOM WAS FOUND, USE PS AS IS.
60600	CQ70      X=(R5-R4)/(PS(N)-R4)
60700	C SHIFT ALL POINTS BY THIS FACTOR
60800	CQ        DO 75 L=1,N
60900	CQ        PS(L)=R4+(PS(L)-R4)*X
61000	CQ75      PR(L)=R4+(PR(L)-R4)*X
61100	CQ        GO TO 203
61200	CQ71      DO 72 L=1,N
61300	C GET BACK ORIGINAL DATA AND GO THRU LOOP AGAIN WITH FACTOR
61400	CQ        PS(L)=PSX(L)
61500	CQ        PR(L)=PRR(L)
61600	CQ72      PG(L)=(PS(L)-PR(L)-PL(L))*X
61700	CQ        J=-1
61800	CQ        GO TO 61
61900	
62000	C NOW PS(1) SHOULD BE >=R4, PS(N)<=R5.
62100	203	CALL MOVIT(RN,NO,0.0,2000.0,1000.0,0.0)
62200	C  MOVE EVERYTHING 1000 TO RIGHT
62300	CCC203	CALL MOVIT(RN,NO,R5,2000.0,1000.0,0.0)
62400	C MOVE ANYTHING TO RIGHT OF JUSTIFY AREA FAR TO RIGHT.
62500	CC CAN'T USE DO LOOP, FAIL PROG. WIPES OUT AC15.	DO 206 K=1,N
62600	CC	CALL MOVIT(RN,NO,R4,R5,500.0,0.0)
62700	C NOW MOVE JUSTIFY AREA 500 TO RIGHT. LEAVES ROOM FOR EXPANSION, CONTRACTION.
62800		K=2
62900		L=1
63000	C A= AMOUNT MOVED LEFT OR RIGHT.
63100	206	CALL MOVIT(RN,NO,P(L)+1000.0,P(K)+1000.0,PS(L),PS(K))
63200	C MOVE OLD RANGE INTO NEW RANGE (AND SHIFT BACK 1000)
63300		L=K
63400		K=K+1
63500		IF(K.LE.N)GO TO 206
63600		CALL MOVIT(RN,NO,1000.0,3000.0,-1000.0,0.0)
63700	CCC	CALL MOVIT(RN,NO,R5+1000.0,3000.0,-1000.0,0.0)
63800	C MOVE BACK THINGS TO RIGHT OF JUSTIFY AREA.  NOW ALL DONE.
63900	300	END